perm filename TJAK.F4[CMS,LCS] blob
sn#095236 filedate 1974-04-02 generic text, type T, neo UTF8
00100 DIMENSION NL(72),NE(50),IE(1000),NW(1000)
00200 COMMON NL,NE,IE,NW,J,M,N
00300
00400 1 J=J+1
00500 L=0
00600 CALL IREAD(L)
00700 IF(L)GO TO 1
00800 J=J-1
00900 TYPE 10
01000 10 FORMAT(' TYPE LINE NUM'/)
01100 ACCEPT 11,NA
01200 11 FORMAT(A1)
01300 IF(NA.NE.' ')GO TO 33
01400 LN=0
01500 35 LN=LN+1
01600 36 IF(LN.GT.J)GO TO 1
01700 CALL IRITE(LN)
01800 25 TYPE 14,NL
01900 14 FORMAT(1X72A1/)
02000 IF(NA.EQ.' ')GO TO 35
02100 GO TO 1
02200 33 REREAD 34,LN
02300 34 FORMAT(I2)
02400 IF(LN.LT.1)GO TO 13
02500 GO TO 36
02600 13 TYPE 6,(NE(I),I=1,J)
02700 6 FORMAT(1X10I7)
02800 TYPE 6,(IE(I),I=1,M)
02900 TYPE 7,(NW(I),I=1,N)
03000 7 FORMAT(1X70A1)
03100 TYPE 8,J,M,N
03200 8 FORMAT(1X3I/)
03300 GO TO 1
03400 END
03500
03600 SUBROUTINE IREAD(L)
03700 COMMON NL(72),NE(50),IE(1000),NW(1000),J,M,N
03800 LT=0
03900 1 ACCEPT 2,NL
04000 2 FORMAT(72A1)
04100 CALL JOKES(LT,NL(1))
04200 IF(LT)GO TO 4
04300 IF(L)GO TO 1
04400 RETURN
04500
04600 4 NE(J)=(M+1)*1000
04700 I=0
04800 5 K=0
04900 6 I=I+1
05000 31 IF(I.GT.72)GO TO 7
05100 IF(NL(I).EQ.' ')GO TO 6
05200 KN=0
05300 9 KN=KN+1
05400 IF(KN.GT.N)GO TO 10
05500 IF(NW(KN).NE.NL(I))GO TO 9
05600 KM=1
05700 IF(.NOT.NL(I))GO TO 12
05800 11 IF(I+KM.GT.72)GO TO 30
05900 IF(NL(I+KM).EQ.' '.OR..NOT.NL(I+KM))GO TO 12
06000 IF(KN+KM.GT.N)GO TO 10
06100 IF(NW(KN+KM).NE.NL(I+KM))GO TO 9
06200 KM=KM+1
06300 GO TO 11
06400 30 KM=KM-1
06500 12 M=M+1
06600 IE(M)=KN*100+KM
06700 I=I+KM
06800 GO TO 31
06900 13 I=I+1
07000 10 K=K+1
07100 NW(N+K)=NL(I)
07200 IF(.NOT.NL(I).OR.I.EQ.72)GO TO 8
07300 IF(NL(I+1).NE.' '.AND.NL(I+1))GO TO 13
07400 8 M=M+1
07500 IE(M)=(N+1)*100+K
07600 N=N+K
07700 GO TO 5
07800 7 NE(J)=NE(J)+M
07900 L=-1
08000 RETURN
08100 END
08200
08300 SUBROUTINE IRITE(LN)
08400 COMMON NL(72),NE(50),IE(1000),NW(1000),J,M,N
08500 I=0
08600 NN=NE(LN)/1000
08700 MM=MOD(NE(LN),1000)+1
08800 23 I=I+1
08900 IF(NN.EQ.MM)GO TO 19
09000 KM=IE(NN)/100
09100 LL=KM+MOD(IE(NN),100)
09200 24 IF(KM.EQ.LL)GO TO 20
09300 NL(I)=NW(KM)
09400 IF(I.EQ.72)RETURN
09500 KM=KM+1
09600 I=I+1
09700 GO TO 24
09800 20 IF(NN.LT.MM)NN=NN+1
09900 19 NL(I)=' '
10000 IF(I.EQ.72)RETURN
10100 GO TO 23
10200 END
10300